home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / vis082s.arc / SORTING.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-18  |  1.1 KB  |  48 lines
  1.  
  2. procedure shellsort(Left,Right:integer);
  3. label
  4.    Again;
  5. var
  6.    Pivot:integer;
  7.    P,Q:integer;
  8.    tp1,tp2,tp3,tp4:udrec;
  9.  
  10.    begin
  11.       P:=Left;
  12.       Q:=Right;
  13.       Pivot:=(Left+Right) div 2;
  14.       seek(udfile,pivot);
  15.       read(udfile,tp1);
  16.       while P<=Q do
  17.       begin
  18.        seek(udfile,p);
  19.        read(udfile,tp2);
  20.        while (upstring(tp2.filename)<upstring(tp1.filename)) do begin
  21.              inc(p);
  22.              seek(udfile,p);
  23.              read(udfile,tp2);
  24.        end;
  25.          seek(udfile,q);
  26.          read(udfile,tp3);
  27.          while (upstring(tp1.filename)<upstring(tp3.filename)) do begin
  28.                dec(Q);
  29.                seek(udfile,q);
  30.                read(udfile,tp3);
  31.          end;
  32.          if P>Q then goto Again;
  33.          tp4:=tp3;
  34.          tp3:=tp2;
  35.          tp2:=tp4;
  36.          seek(udfile,p);
  37.          write(udfile,tp2);
  38.          seek(udfile,q);
  39.          write(udfile,tp3);
  40.          inc(P);
  41.          dec(Q);
  42.       end;
  43.  
  44.       Again:
  45.       if Left<Q  then shellsort(left,Q);
  46.       if P<Right then shellsort(P,Right);
  47. end;
  48.